home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / arexx / arexg10c.lha / ARexxGuide / ARx_IactExamples.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-10-15  |  9.9 KB  |  304 lines
  1. /* $VER: 1.0a ARx_IactExamples by Robin Evans (8 Jul 1993,15 Oct 1993) */
  2.  
  3. foo = address()
  4. address REXX
  5. call trace 'B'
  6.  
  7. call addlib('rexxsupport.library',0,-30,0)
  8.  
  9.     /* My thanks to Tom Miller on GEnie for pointing out this elegant **
  10.     ** way to redirect output and input to a new window               */
  11.  
  12. arg SubR .
  13.  
  14.     /* set up various formatting codes in compound variables that     **
  15.     ** can be exposed to subroutines by using just the stem           */
  16. csi='9b'x;f.slant=csi'3m'; f.bold=csi'1m'; f.norm=csi'0m'
  17.              f.black=csi'31m'; f.white=csi'32m'; f.blue=csi'33m'
  18.              f.lf = '0a'x; f.cls = csi'0;0H'csi'J'
  19.  
  20. options prompt f.white':::' f.norm
  21.  
  22.     /* Create a new standard-I/O console, so that we can use say      **
  23.     ** and pull instead of writeln() and readln() for output and      **
  24.     ** input. Note: the { system "rx.."} used in the AG link is       **
  25.     ** there because this setup won't work when AG is called by icon  **
  26.     ** unless that kludge is there. Using AG's RX command, the input  **
  27.     ** stream isn't opened under a workbench call                     */
  28. call close STDOUT
  29. if open(STDOUT, "con:98/8/584/345/ARexxGuide Examples/NOCLOSE", w) then do
  30.     call close STDIN
  31.     call open STDIN, "*", W
  32.     call pragma '*' STDOUT
  33.     call pragma '*' STDIN
  34.         /* for some odd reason, the Amiga shell won't reliably call an  **
  35.         ** external function when at the default Amigaguide address     */
  36.     address REXX
  37.     interpret 'call' SubR 'CLOSE'
  38.     call close STDOUT
  39.     call close STDIN
  40.     call pragma('*')
  41.     return 0
  42.     address
  43. end
  44. else
  45.     signal error
  46.  
  47. SYNTAX:
  48.     ErrCo = rc
  49. ERROR:
  50.     signal off SYNTAX            /* to prevent any possibility of an endless loop */
  51.  
  52.     say '0a'x
  53.     say 'Sorry, an unexpected error has occured in line' SIGL
  54.     if datatype(ErrCo, 'N') then
  55.     say '      'ErrCo':' errortext(ErrCo)
  56.     call delay(1000)
  57.     push endcli
  58. exit 9
  59.  
  60.  
  61. /* Get rid of a range of unprintable characters */
  62. arg inputfile
  63. call open($t,inputfile,'r')
  64. call open($n, 't:noNonPrint','W')
  65. do until eof($t)
  66.     ln=readln($t)
  67.     nl=compress(ln,xrange('0'x, '19'x))
  68.     call writeln($n, nl)
  69. end
  70.  
  71. exit
  72.  
  73. /*    $VER: 1.0 ShowNumeric.rexx by Robin Evans (21 May 1993) */
  74.  
  75. ShowNumeric: procedure expose f.
  76.  
  77. /* Demonstrate the effect of different settings of NUMERIC DIGITS
  78. **    and NUMERIC FUZZ
  79. */
  80. arg CLOSE
  81. options failat 21    /* to retain control when an error occurs */
  82. signal on ERROR
  83. signal on SYNTAX
  84.  
  85. say f.white||'This example will demonstrate how different settings of'
  86. say 'NUMERIC DIGITS and NUMERIC FUZZ affect the comparison'
  87. say 'of numeric values.'  '0a'x
  88. say 'Enter two numbers separated by at least one space, then'
  89. say 'press <Enter>.'
  90. say f.lf'To quit, press <Q> and <Enter>.'f.lf||f.norm
  91.  
  92. do MainLoop = 1        /* exits on the datatype() check 4 lines down */
  93.     say f.lf||f.blue'Enter two numbers to be compared:'
  94.     pull Num.1 Num.2 .
  95.     do i = 1 to 2
  96.             /* any non-numeric value (including null) causes an exit from
  97.             **    the main loop above.
  98.             */
  99.         Num.i = compress(Num.i, ',')
  100.         if ~datatype(Num.i,N) then do
  101.             if ~abbrev(upper(Num.i), 'Q') then do
  102.                 say 'You must enter two numbers.'f.white '   <Enter' f.blue'Q'f.white 'to quit>'f.black
  103.                 iterate MainLoop
  104.             end
  105.             else
  106.                 leave MainLoop
  107.         end
  108.             /* a decimal point is not considered part of a number's length */
  109.         Num.i.len = length(compress(Num.i,'.'))
  110.     end
  111.     MNum = max(num.1, num.2)
  112.     XLen = max(num.1.len, num.2.len)
  113.     numeric digits min(XLen, 14)
  114.     if XLen > 14 then do
  115.         say f.white'The greatest precision available in ARexx is 14 digits.'
  116.         say 'The number you entered with' XLen 'digits would always'
  117.         say 'be rounded to the closest 14-digit value:'||f.norm
  118.             /*
  119.             **    the prefix + sign causes MNum to be evaluated according to the
  120.             **    current digits() setting
  121.             */
  122.         say '       ' (+MNum) '0a'x
  123.         XLen = 14
  124.     end
  125.     NLen = min(num.1.len, num.2.len)
  126.         /* begin with a setting which will handle the largest number entered */
  127.  
  128.         /* if the numbers are equal under the most precise setting, then
  129.         **    they will be equal under any other setting as well
  130.         */
  131.     if num.1 = num.2 then do
  132.         say num.1 'will always be equal in any comparison to' num.2
  133.         call ShowImprecise
  134.     end
  135.     else do
  136.         numeric fuzz digits() - 1
  137.             /*
  138.                 check for equality under the least precise setting and then
  139.                 find out the most precise setting at which the two are equal
  140.             */
  141.         if num.1 = num.2 then do
  142.         numeric fuzz        /* reset to make the first comparison at 0 */
  143.             do i=0 to XLen-1 while num.1 ~= num.2
  144.                 numeric fuzz i
  145.             end
  146.             if num.1 = num.2 then do
  147.                 say num.1 'is considered equal to' num.2 'under these conditions:'
  148.                 say '   DIGITS setting of' digits()
  149.                 say '   FUZZ   setting of' fuzz()
  150.                 say '   or at a FUZZ setting of 0 and DIGITS setting of' digits() - fuzz()
  151.                 numeric fuzz
  152.                 say f.white'      The following table shows how the numbers are presented'
  153.                 say '      under different settings of NUMERIC DIGITS.'
  154.                 say '      Digits()   'left(Num.1,18)    (Num.2)
  155.                 say f.blue'      ---------  ------------------ ------------------'f.norm
  156.                 do j = max(1,digits()-i) to xlen until strip(MNum) == (+MNum)
  157.                     numeric digits j
  158.                     say '     'center(digits(),11) left((+Num.1),18) (+Num.2)
  159.                 end
  160.             end
  161.         end
  162.         else do
  163.             say max(num.1, num.2) 'will always be considered greater than' min(num.1, num.2)
  164.             call ShowImprecise
  165.         end
  166.     end
  167.     numeric fuzz
  168.     numeric digits
  169. end
  170. if close = 'CLOSE' then
  171.     push endcli
  172. return 0
  173.  
  174. ShowImprecise:
  175.  
  176.         say f.white'   The following chart shows the two numbers under the'
  177.         say '   most imprecise settings of NUMERIC DIGITS 1 and 2'
  178.         say '   'left(Num.1,15) Num.2
  179.         say f.blue'    -------------- --------------'f.norm
  180.         numeric fuzz
  181.         numeric digits 1
  182.         say '   'left((+Num.1),15) (+Num.2)
  183.         numeric digits 2
  184.         say '   'left((+Num.1),15) (+Num.2)||f.norm
  185. return
  186.  
  187. /*    $VER: 1.0 ShowSTDIO.rexx by Robin Evans (11 Jun 1993) */
  188.  
  189. ShowSTDIO: procedure expose f.
  190.  
  191. /* Demonstrate the effect of redirected IO. */
  192.  
  193. arg CLOSE
  194. options failat 21    /* to retain control when an error occurs */
  195. signal on ERROR
  196. signal on SYNTAX
  197.  
  198. LFS = f.lf||f.white
  199.  
  200. do forever        /* Loop allows reentering the demonstration */
  201.     say f.cls
  202.     say 'This demonstration will write a small ARexx file to the t:'
  203.     say 'directory.'
  204.     say
  205.     say 'That file will be called with various forms of redirection'
  206.     say 'to demonstrate the effect of redirection characters on '
  207.     say 'ARexx files.'
  208.  
  209.         /* Save the demo file to the ram: disk T: directory */
  210.     TFName = 't:testIO.rexx'
  211.     TestCode = '/**/'f.lf'options prompt "0a"x||"Enter any text then press <Enter>: "'f.lf'pull T$'f.lf'say "0a"x||"You entered:" T$'f.lf
  212.     if open(TFile, TFName, w) then do
  213.         call writech(TFile, TestCode)
  214.         call close TFile
  215.         if QKey() then return 0
  216.         say LFS'The file has been written to the T: directory:'
  217.         call showSPrompt('list' left(TFName, 5)'#?')
  218.         call showSPrompt( 'type' TFname)
  219.         if QKey() then return 0
  220.         say f.lf LFS'We will now run that program. Enter some text when prompted:'
  221.         call showSPrompt('rx' TFname)
  222.         say LFS'Notice that the program output to the shell the text you entered.'
  223.         if QKey() then return 0
  224.         say LFS'We''ll run it again, but this time we''ll redirect output using'
  225.         say '   the DOS ">" redirection operator.'
  226.         call showSPrompt('rx' TFname '>T:IOutput')
  227.         say LFS'Notice that the program didn''t output anything this time, even'
  228.         say '   though the SAY instruction is still in the program.'
  229.         say '   What happened? Observe:'
  230.         call showSPrompt('type T:IOutput')
  231.         say LFS'Because of the redirection operator, the output of SAY went to a'
  232.         say '   file instead of to the screen.'
  233.         if QKey() then return 0
  234.         say LFS'What happens when both input and output are redirected?'
  235.         call showSPrompt('rx' TFname '<'TFName '>T:IOutput')
  236.         say LFS'There was no prompt this time because the PULL instruction was'
  237.         say '   redirected to look for its input from the file "'TFName'".'
  238.         say '   It pulled the first line from that file:'
  239.         call showSPrompt('type T:IOutput')
  240.     end
  241.     say f.lf'This concludes the demonstration.'
  242.     say '   Press <Enter> to quit or <R> and <Enter> to repeat the demo.'
  243.     pull Rsp
  244.     if Rsp ~= 'R' then leave
  245. end
  246. return 0
  247.  
  248. QKey: procedure expose f.
  249.     options prompt f.lf||f.blue'   Type <Q> and <Enter> to quit. Press <Enter> alone to continue.'f.norm
  250.     pull QKey
  251.     if QKEY = Q then return 1
  252.     else return 0
  253.  
  254. ShowSPrompt: procedure expose f.
  255.     address command
  256.     parse arg DCmd
  257.     call writech(STDOUT, f.lf||f.blue'Shell'f.white'> 'f.norm)
  258.     call delay(30)
  259.     say DCmd
  260.     ""DCmd
  261. return 0
  262.  
  263. DoBreak: procedure expose f.
  264.       /* Show how the break keys work in a subroutine */
  265.         signal off break_e
  266.       Say f.white" Press Control and E to stop the obnoxious listing that"
  267.       say " will follow this message."f.black
  268.       if QKey() then return
  269.       NumRepeats = AdInfinit()
  270.       say f.white||f.lf'The message was repeated' NumRepeats 'times.'
  271.       say f.lf'We have returned from a subroutine to the main code of'
  272.       say 'the program. The break key was detected within the subroutine'
  273.       say 'but control could still be returned to the main program.'
  274.       say f.lf||f.white'   This demo is coded in the file' f.blue'ARx_IactExamples.rexx'
  275.       say f.white'   in the subroutine' f.blue'DoBreak:'
  276.       say f.black||f.lf'- Press any key - '
  277.       pull .
  278.       return
  279.  
  280.          /* The subroutine being called by SIGNAL can be anywhere in **
  281.          ** program. PROCEDURE¤¤, used in AdInfinit blinds it to     **
  282.          ** variables in the main program, but still allows the      **
  283.          ** BREAK_E subroutine to retrieve the [Rep] variable.       */
  284.  
  285.       BREAK_E:
  286.          say f.blue'Break detected at line' SIGL':'
  287.          say f.white||sourceline(SIGL)
  288.          return Rep
  289.  
  290.       AdInfinit: PROCEDURE expose f.
  291.             /* turning on the signal within the subroutine¤¤ means    **
  292.             ** it will be effective only while this subroutine is     **
  293.             ** active                                                 */
  294.          signal on break_e
  295.          do Rep = 1
  296.             say 'Press Ctrl-E at any time.'
  297.             call delay 25
  298.             say 'Stop me. Please.'
  299.          end
  300.             /* because the loop¤¤ above is endless, this RETURN¤¤     **
  301.             ** will never be reached.                                 */
  302.          return 0
  303.  
  304.